home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / prolog / brklyprl.lha / Comp / unravel.pl < prev    next >
Text File  |  1989-04-14  |  4KB  |  118 lines
  1.  
  2. /* Copyright (C) 1988, 1989 Herve' Touati, Aquarius Project, UC Berkeley */
  3.  
  4. /* Copyright Herve' Touati, Aquarius Project, UC Berkeley */
  5.  
  6. % All structures are unraveled into unify goals.
  7. % All unify goals are of the form Var1=(Var2 or Atom or Struc),
  8. % where Var1 is temporary or permanent and
  9. % where Struc has only variables and atoms as arguments.
  10. % If Var1 is permanent then so is Var2.
  11. % Preexisting unify goals are transformed into this type.
  12. % The structure of disjunctions remains the same (i.e.
  13. % the operator ';' remains).  Only the content is unraveled.
  14.  
  15. % Bug fix - 7/31/85:
  16. %   Handle case where the null list is an element of a list or a structure.
  17. %    - Wayne
  18.  
  19. unravel([Head|Body], [NewHead|Ravel], Perms) :-
  20.     spread(Head, NewHead, Ravel-L),
  21.     xunravel(Body, L-[], Perms), !.
  22.  
  23. xunravel([Dis|Rest], [DRavel|Ravel]-Link, Perms) :-
  24.     Dis=(_;_),
  25.     disunravel(Dis, DRavel, Perms),
  26.     xunravel(Rest, Ravel-Link, Perms).
  27. xunravel([Goal|Rest], Ravel-Link, Perms) :-
  28.     Goal=(_=_),
  29.     varunify(Goal, Ravel-L, Perms),
  30.     xunravel(Rest, L-Link, Perms).
  31. xunravel([Goal|Rest], Ravel-Link, Perms) :-
  32.     spread(Goal, NewGoal, Ravel-L),
  33.     L=[NewGoal|L2],
  34.     xunravel(Rest, L2-Link, Perms).
  35. xunravel([], Link-Link, _).
  36.  
  37. disunravel((A;B), (ARavel;BRavel), Perms) :- !,
  38.     xunravel(A, ARavel-[], Perms),
  39.     disunravel(B, BRavel, Perms).
  40. disunravel(A, ARavel, Perms) :-
  41.     xunravel(A, ARavel-[], Perms).
  42.  
  43.  
  44. % Unification optimization.
  45. % Turn the general goal 'X=Y' into a sequence
  46. % of simpler unifications of the form
  47. % Var1=(Var2 or Atom or Struc),
  48. % where Var1 is a temporary or permanent variable, and
  49. % where Struc has only atoms and variables as arguments.
  50. varunify(X=Y, Code-Link, Perms) :-
  51.     (xvarunify(X=Y, Code-Link, Perms); Code=[fail|Link]).
  52.  
  53. % One argument is a temporary variable:
  54. xvarunify(A=B, [A=NewB|L]-Link, Perms) :-
  55.     var(A), notin(A,Perms), !,
  56.     spread(B, NewB, L-Link).
  57. xvarunify(A=B, [B=NewA|L]-Link, Perms) :-
  58.     var(B), notin(B,Perms), !,
  59.     spread(A, NewA, L-Link).
  60. % One argument is a permanent variable:
  61. xvarunify(A=B, [A=NewB|L]-Link, Perms) :-
  62.     in(A,Perms), !,
  63.     spread(B, NewB, L-Link).
  64. xvarunify(A=B, [B=NewA|L]-Link, Perms) :-
  65.     in(B,Perms), !,
  66.     spread(A, NewA, L-Link).
  67. % Both arguments are nonvariables:
  68. xvarunify(A=B, Link-Link, Perms) :-
  69.     atomic(A), !, atomic(B), A=B.
  70. xvarunify(A=B, Code-Link, Perms) :-
  71.     atomic(B), !, fail.
  72. xvarunify(A=B, Code-Link, Perms) :- % A&B are structures
  73.     A=..[Func|ArgsA],
  74.     B=..[Func|ArgsB],
  75.     lvarunify(ArgsA, ArgsB, Code-Link, Perms).
  76.  
  77. lvarunify([A|ArgsA], [B|ArgsB], Code-Link, Perms) :-
  78.     xvarunify(A=B, Code-L, Perms), !,
  79.     lvarunify(ArgsA, ArgsB, L-Link, Perms).
  80. lvarunify([], [], Link-Link, Perms).
  81.  
  82.  
  83. % Take a (possibly nested) structure apart into
  84. % (1) a simple structure, and (2) a series of unify goals. 
  85. % A list is considered as a structure with variable arity.
  86. % Its cdr field is given a separate unify goal to
  87. % accommodate the unify_cdr instruction.
  88. spread(Var, Var, Link-Link) :- var(Var), !.
  89. spread(Atomic, Atomic, Link-Link) :- atomic(Atomic), !.
  90. spread(List, SimpleList, Rest-Link) :-
  91.     list(List), !,
  92.     argspread(CdrUnify, List, SimpleList, Ravel-Link),
  93.     check_cdr(CdrUnify, Ravel, Rest).
  94. spread(Struc, SimpleStruc, Rest-Link) :-
  95.     Struc=..[Name|Args],
  96.     argspread(_, Args, VArgs, Rest-Link),
  97.     SimpleStruc=..[Name|VArgs].
  98.  
  99.     check_cdr(none, Ravel, Ravel) :- !.
  100.     check_cdr(CdrUnify, Ravel, [CdrUnify|Ravel]).
  101.  
  102. argspread(none, Cdr, Cdr, Link-Link) :-
  103.     (var(Cdr);Cdr==[]), !.
  104. argspread(T=SimpleCdr, Cdr, T, Ravel-Link) :-
  105.     nonlist(Cdr), !,
  106.     spread(Cdr, SimpleCdr, Ravel-Link).
  107. % arg is null list
  108. argspread(CdrUnify, [S|Args], [T|VArgs], [T=[]|L]-Link) :-
  109.     nonvar(S), S = [], !,
  110.     argspread(CdrUnify, Args, VArgs, L-Link).
  111. argspread(CdrUnify, [A|Args], [A|VArgs], Ravel-Link) :-
  112.     (atomic(A); var(A)), !,
  113.     argspread(CdrUnify, Args, VArgs, Ravel-Link).
  114. argspread(CdrUnify, [S|Args], [T|VArgs], Ravel-Link) :-
  115.     Ravel=[T=V|L],
  116.     spread(S, V, L-L2),
  117.     argspread(CdrUnify, Args, VArgs, L2-Link).
  118.